home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 5 / Apprentice-Release5.iso / Environments / PowerMacOberon feb96 / Dialogs / DialogFrames.Mod (.txt) < prev    next >
Encoding:
Oberon Text  |  1995-06-30  |  8.8 KB  |  232 lines  |  [TEXT/.Ob4]
  1. Syntax10.Scn.Fnt
  2. Syntax10i.Scn.Fnt
  3. StampElems
  4. Alloc
  5. 2 Feb 95
  6. Syntax10b.Scn.Fnt
  7. MODULE DialogFrames;
  8.     (** extended version Markus Knasm
  9. ller 25.May.94 -  
  10.     IMPORT
  11.         Dialogs, Display, Files, Input, MenuViewers, Oberon, TextFrames, Texts, Viewers;
  12.     CONST
  13.         bkCol = 13;
  14.         menu = "System.Close  System.Copy  System.Grow";
  15.         gridMax* = 100; gridMin* = 1;
  16.     TYPE
  17.         Frame* = POINTER TO FrameDesc;
  18.         FrameDesc* = RECORD(Display.FrameDesc)
  19.             col*: INTEGER;  (** background-color of the frame *)
  20.             panel*: Dialogs.Panel;  (** panel displayed in this frame *)
  21.             grid*: INTEGER; (** grid of the frame *)
  22.             pat*: Display.Pattern; (** background-pattern *)
  23.         END;
  24.         GetFrameMsg* = RECORD(Display.FrameMsg)
  25.             p*: Dialogs.Panel;
  26.             f*: Frame;
  27.         END;
  28.         SetCaretMsg = RECORD(Display.FrameMsg)
  29.             p: Dialogs.Panel;  
  30.             x, y: INTEGER;
  31.         END; 
  32.         w0: Texts.Writer;
  33.         left, right, top, bot: INTEGER;
  34.     PROCEDURE Min (x, y: INTEGER): INTEGER;
  35.     BEGIN IF x < y THEN RETURN x ELSE RETURN y END
  36.     END Min;
  37.     PROCEDURE (f: Frame) MarkMenu; 
  38.     (* see TextFrames *)
  39.         VAR r: Texts.Reader; v: Viewers.Viewer; t: Texts.Text; ch: CHAR; 
  40.     BEGIN 
  41.         v := Viewers.This (f.X, f.Y);
  42.         IF (v IS MenuViewers.Viewer) & (v.dsc IS TextFrames.Frame) & (f # v.dsc) THEN
  43.             t := v.dsc(TextFrames.Frame).text;
  44.             IF t.len > 0 THEN Texts.OpenReader(r, t, t.len - 1); Texts.Read(r, ch) ELSE ch := 0X END;
  45.             IF ch # "!" THEN Texts.Write(w0, "!"); Texts.Append(t, w0.buf) END
  46.         END;
  47.     END MarkMenu;
  48.     PROCEDURE (f: Frame) Restore*;
  49.     (** restores the frame *)
  50.     BEGIN
  51.         Oberon.RemoveMarks (f.X, f.Y, f.W, f.H); 
  52.         IF f.pat # MAX (INTEGER) THEN
  53.             Display.ReplPatternC (f, f.col, f.pat, f.X, f.Y, f.W, f.H, f.X, f.Y, Display.replace)
  54.         ELSE
  55.             Display.ReplConstC (f, f.col, f.X, f.Y, f.W, f.H, Display.replace)
  56.         END;
  57.         f.panel.Draw (f.X, f.Y + f.H, f)
  58.     END Restore;
  59.     PROCEDURE (f: Frame) DrawObject (o: Dialogs.Object; drawmode: BOOLEAN);
  60.     (* drawmode = TRUE => Draw     drawmode = FALSE => Delete *)
  61.         VAR x, y, ox, oy, ow, oh: INTEGER; i: LONGINT;
  62.     BEGIN 
  63.         o.GetDim (ox, oy, ow, oh); x := f.X + ox; y := f.Y + f.H + oy; 
  64.         Oberon.RemoveMarks (x, y, ow, oh); 
  65.         IF (~ drawmode) THEN  
  66.             Display.ReplConstC (f, f.col, x, y, ow, oh, Display.paint); 
  67.             IF f.pat # MAX (INTEGER) THEN Display.ReplPatternC (f, f.col, f.pat, x, y, ow, oh, f.X, f.Y, Display.replace) END
  68.         ELSE
  69.             o.Draw (x, y, f) 
  70.         END
  71.     END DrawObject;
  72.     PROCEDURE (f: Frame) TrackMouse (x, y: INTEGER; keys: SET);
  73.     BEGIN 
  74.         Oberon.DrawCursor (Oberon.Mouse, Oberon.Arrow, x, y);
  75.         WHILE keys # {} DO
  76.             Input.Mouse (keys, x, y);
  77.             Oberon.DrawCursor (Oberon.Mouse, Oberon.Arrow, x, y);
  78.         END 
  79.     END TrackMouse;
  80.     PROCEDURE (f: Frame) Send (x, y: INTEGER; VAR m: Display.FrameMsg; VAR cond: BOOLEAN);
  81.         VAR o: Dialogs.Object;
  82.     BEGIN
  83.         o := f.panel.ThisObject (x - f.X, y - f.Y - f.H);
  84.         IF o # NIL THEN o.Handle (f, m); cond := TRUE ELSE cond := FALSE END 
  85.     END Send;
  86.     PROCEDURE (f: Frame) Extend (newY: INTEGER);
  87.         VAR dY, newH: INTEGER;
  88.     BEGIN 
  89.         dY := f.Y - newY;
  90.         IF f.pat # MAX (INTEGER) THEN
  91.             Display.ReplPattern (f.col, f.pat, f.X, newY, f.W, f.Y - newY, Display.replace)
  92.         ELSE
  93.             Display.ReplConst (f.col, f.X, newY, f.W, f.Y - newY, Display.replace)
  94.         END;
  95.         f.H := f.H + f.Y - newY; f.Y := newY;
  96.         f.panel.Draw (f.X, f.Y + f.H, f)
  97.     END Extend;
  98.     PROCEDURE (f: Frame) Reduce (newY: INTEGER);
  99.     BEGIN f.H := f.H + f.Y - newY; f.Y := newY
  100.     END Reduce;
  101.     PROCEDURE (f: Frame) Modify (id, dY, y, h: INTEGER);
  102.     BEGIN
  103.         Oberon.RemoveMarks(f.X, f.Y, f.W, f.H);
  104.         f.panel.RemoveSelections;
  105.         IF id = MenuViewers.extend THEN
  106.             IF dY > 0 THEN
  107.                 IF f.pat # MAX (INTEGER) THEN
  108.                     Display.ReplPattern (f.col, f.pat, f.X, f.Y + dY, f.W, f.H, Display.replace)
  109.                 ELSE
  110.                     Display.ReplConst (f.col, f.X, f.Y + dY, f.W, f.H, Display.replace)
  111.                 END;
  112.                 INC (f.Y, dY)
  113.             END;
  114.             f.Extend (y)
  115.         ELSIF id = MenuViewers.reduce THEN
  116.             f.Reduce (y + dY);
  117.             IF dY > 0 THEN Display.CopyBlock(f.X, f.Y, f.W, f.H, f.X, y, Display.replace); f.Y := y END
  118.         END
  119.     END Modify;
  120.     PROCEDURE Handle* (f: Display.Frame; VAR m: Display.FrameMsg);
  121.     (** handles the message m sent to frame f *)
  122.     VAR cond: BOOLEAN; copy: Frame;
  123.         PROCEDURE IsIn (f: Display.Frame; x, y: INTEGER): BOOLEAN;
  124.         BEGIN
  125.             IF (x >= f.X) & (x <= f.X + f.W) & (y > f.Y) & (y <= f.Y + f.H) THEN RETURN TRUE ELSE RETURN FALSE END
  126.         END IsIn;
  127.     BEGIN
  128.         WITH f: Frame DO
  129.             WITH m: Oberon.InputMsg DO 
  130.                 IF m.id = Oberon.track THEN 
  131.                     IF IsIn (f, m.X, m.Y) THEN
  132.                         f.Send (m.X, m.Y, m, cond); (* sends it to object *)
  133.                         IF ~ cond THEN f.TrackMouse (m.X, m.Y, m.keys) (* draws cursor if there is no object *) END
  134.                     END
  135.                 ELSE f.panel.Broadcast (f, m)
  136.                 END
  137.             | m: MenuViewers.ModifyMsg DO f.Modify (m.id, m.dY, m.Y, m.H); f.panel.Broadcast (f, m)
  138.             | m: Oberon.CopyMsg DO NEW (copy); copy^ := f^; m.F := copy; 
  139.             | m: Dialogs.NotifyMsg DO
  140.                 IF m.id = 0 THEN IF f.panel.Contains (m.obj) THEN f.DrawObject (m.obj, TRUE) END
  141.                 ELSIF m.id = 1 THEN IF f.panel.Contains (m.obj) THEN f.DrawObject (m.obj, FALSE) END
  142.                 ELSIF m.id = 2 THEN IF m.p = f.panel THEN  f.MarkMenu END
  143.                 ELSIF m.id = 3 THEN IF m.p = f.panel THEN f.Restore END
  144.                 END
  145.             | m: SetCaretMsg DO
  146.                 IF m.p = f.panel THEN
  147.                     Oberon.RemoveMarks (f.X, f.Y, f.W, f.H); Oberon.Pointer.X := m.x + f.X; Oberon.Pointer.Y := m.y + f.Y + f.H;
  148.                 END
  149.             | m: GetFrameMsg DO
  150.                 IF f.panel = m.p THEN m.f := f END
  151.             ELSE
  152.                 f.panel.Broadcast (f, m)  (* sends it to all objects in the panel *)
  153.             END
  154.         END
  155.     END Handle;
  156.     PROCEDURE (f: Frame) Open* (handle: Display.Handler; p: Dialogs.Panel);
  157.     (** opens the frame f with the handler handle and the panel p *)
  158.     BEGIN f.handle := handle; f.panel := p; f.col := bkCol; f.grid := 1; f.pat := MAX (INTEGER) 
  159.     END Open;
  160.     PROCEDURE GetCaretPosition* (VAR p: Dialogs.Panel; VAR xpos, ypos: INTEGER);
  161.     (** returns the panel p and the positin (xpos, ypos) of the caret *)
  162.         VAR x, y: INTEGER; f: Frame; v: Viewers.Viewer;
  163.     BEGIN
  164.         x := Oberon.Pointer.X; y := Oberon.Pointer.Y;  
  165.         v := Viewers.This (x, y);
  166.         IF (v.dsc # NIL) & (v.dsc.next # NIL) & (v.dsc.next IS Frame) THEN 
  167.             f := v.dsc.next(Frame); p := f.panel; xpos := x - f.X; ypos := y - f.Y - f.H
  168.         ELSE p := NIL
  169.         END
  170.      END GetCaretPosition;
  171.     PROCEDURE box (obj: Dialogs.Object; VAR done: BOOLEAN);
  172.         VAR x, y, w, h: INTEGER;
  173.     BEGIN
  174.         obj.GetDim (x, y, w, h);
  175.         IF x < left THEN left := x END;
  176.         IF y < bot THEN bot := y END;
  177.         IF x + w > right THEN right := x + w END;
  178.         IF y + h > top THEN top := y + h END
  179.     END box;
  180.     PROCEDURE OpenPanel* (name: ARRAY OF CHAR; x, y: INTEGER; VAR p: Dialogs.Panel);
  181.     (** reads a panel p from file name and opens a viewer at x, y showing that panel *)
  182.         VAR f: Frame; file: Files.File; r: Files.Rider; h, res: INTEGER; v, vmax: Viewers.Viewer; m: TextFrames.Frame;
  183.             t: Texts.Text; buf: Texts.Buffer; 
  184.     BEGIN
  185.         file := Files.Old (name); NEW (p); 
  186.         IF file # NIL THEN Files.Set (r, file, 0); p.Load (r) END;
  187.         NEW (f); f.Open (Handle, p); 
  188.         v := Viewers.This (x, 0);  vmax := NIL; h := 0;
  189.         WHILE v.state > 1  DO 
  190.             IF v.H > h THEN vmax := v; h := v.H END;
  191.             v := Viewers.Next (v)
  192.         END;
  193.         IF vmax # NIL THEN
  194.             left := MAX (INTEGER); right := MIN (INTEGER); bot := MAX (INTEGER); top := MIN (INTEGER);
  195.             p.Enumerate (box);
  196.             y := Min (vmax.Y + ABS (bot) + 10 + TextFrames.menuH, vmax.Y + vmax.H - TextFrames.menuH - 2) 
  197.         END; 
  198.         IF Files.Old ("Dialog.Menu.Text") = NIL THEN 
  199.             m := TextFrames.NewMenu (name, menu)
  200.         ELSE 
  201.             m := TextFrames.NewMenu (name, "");
  202.             NEW (t); Texts.Open (t, "Dialog.Menu.Text");
  203.             NEW (buf); Texts.OpenBuf (buf); Texts.Save (t, 0, t.len, buf); Texts.Append (m.text, buf)
  204.         END;
  205.         v := MenuViewers.New (m, f, TextFrames.menuH, x, y);
  206.         IF p.cmd[0] # 0X THEN 
  207.             Dialogs.cmdPanel := p; 
  208.             Oberon.Call (p.cmd, Oberon.Par, FALSE, res)
  209.         END;
  210.     END OpenPanel;
  211.     PROCEDURE FindObject* (VAR o: Dialogs.Object; VAR p: Dialogs.Panel);
  212.     (** returns the object o below the caret and the panel p containing it *)
  213.         VAR x, y: INTEGER;
  214.     BEGIN
  215.         GetCaretPosition (p, x, y); 
  216.         IF p # NIL THEN 
  217.             o := p.ThisObject (x, y); 
  218.             IF o # NIL THEN Dialogs.res := Dialogs.ok ELSE Dialogs.res := Dialogs.objectNotFound END
  219.         ELSE Dialogs.res := Dialogs.noPanelSelected
  220.         END
  221.     END FindObject;            
  222.     PROCEDURE SetCaretAtObject* (o: Dialogs.Object);
  223.     (** sets the caret in a way that the object o is below the caret *)
  224.         VAR msg: SetCaretMsg; x, y, w, h: INTEGER;
  225.     BEGIN
  226.         o.GetDim (x, y, w, h);
  227.         msg.p := o.panel; msg.x := x; msg.y := y;
  228.         Viewers.Broadcast (msg)
  229.     END SetCaretAtObject; 
  230. BEGIN Texts.OpenWriter (w0)
  231. END DialogFrames.
  232.